home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / usr / share / perl5 / Foomatic / PPD.pm < prev    next >
Text File  |  2008-08-13  |  10KB  |  412 lines
  1.  
  2. package Foomatic::PPD;
  3.  
  4. use Foomatic::UIElem;
  5.  
  6. my @Sections = qw(JCLBegin 
  7.           JCLSetup
  8.           JCLToPSInterpreter
  9.           ExitServer
  10.           Prolog
  11.           DocumentSetup
  12.           PageSetup);
  13.  
  14. sub new {
  15.     my ($type, $filename, $poid) = @_;
  16.  
  17.     open PPD, "$filename" or die;
  18.  
  19.     my %ppd;
  20.  
  21.     $ppd{'filename'} = $filename;
  22.     my ($opt, $optname);
  23.     my ($choice,$choiceverb,$snippet);
  24.     my $l;
  25.     for $l (<PPD>) {
  26.     
  27.     # skip comments
  28.     next if ($l =~ m!^*%!);
  29.     
  30.     # skip blank lines
  31.     next if ($l =~ m!^\s*$!);
  32.     
  33.     if (defined($snippet)) {
  34.         $snippet = "$snippet$l";
  35.         if ($snippet =~ s!\"\s*$!!) {
  36.         $opt->add_option($choice, $choiceverb, $snippet);
  37.         $snippet = undef;
  38.         }
  39.     } elsif (defined($opt)) {      
  40.         # In mid-parse of a UI option clause
  41.         if ($l =~ m!^\*CloseUI: \*$optname!) {
  42.         # close up the $opt object
  43.         push(@{$ppd{'options'}}, $opt);
  44.         $optname = $opt = undef;
  45.         } elsif ($l =~ m!^\*OrderDependency: ([\.\d]+) (AnySetup|JCLSetup|PageSetup|DocumentSetup|Prolog|ExitServer) \*$optname!) {
  46.         my ($order, $section) = ($1, $2);
  47.         $opt->set('order_real'=>$order);
  48.         $opt->set('order_section'=>$section);
  49.         $opt->set('order_keyword'=>$optname);
  50.         } elsif ($l =~ m!^\*Default$optname:\s+([0-9\&A-Za-z]+)!) {
  51.         $opt->set('default'=>$1);
  52.         } elsif ($l =~ m!^\*$optname ([\d\&A-Za-z]+)(\/([^:]+))?:\s*\"([^\"]*)(\")?!) {
  53.         if ($5 eq '"') {
  54.             $opt->add_option($1,$3?$3:$1,$4);
  55.         } else {
  56.             $snippet = $4;
  57.             $choice = $1;
  58.             $choiceverb = $3?$3:$1;
  59.         }
  60.         }
  61.         
  62.     } else {
  63.         # not in UI clause parsing
  64.         if ($l =~ m!^\*NickName:\s*\"(.+)\"!) {
  65.         $ppd{'NickName'} = $1;
  66.         } elsif ($l =~ m!^\*ModelName:\s*\"(.+)\"!) {
  67.         $ppd{'ModelName'} = $1;
  68.         } elsif ($l =~ m!^\*Manufacturer:\s*\"(.+)\"!) {
  69.         $ppd{'Manufacturer'} = $1;
  70.         } elsif ($l =~ m!^\*OpenUI \*([0-9\&A-Za-z]+)(\/(.+))?:\s*(Boolean|PickOne|PickMany)!) {
  71.         my ($name, $label, $type) = ($1, $3, $4);
  72.         # make new $opt object
  73.         $optname = $name;
  74.         $opt = new Foomatic::UIElem ('name'=>$optname,
  75.                          'type'=>$type,
  76.                          'label'=>($label?$label:$name));
  77.         } 
  78.         
  79.         # yadda...
  80.         
  81.     } 
  82.  
  83.     }
  84.     
  85.     close PPD;
  86.  
  87.     my $this = bless \%ppd;
  88.     $this->sort_options();
  89.     $this->{'printer_id'} = $poid;
  90.  
  91.     return $this;
  92. }
  93.  
  94. sub sort_options {
  95.     my $this = $_[0];
  96.  
  97.     # First, sort all the options into sections
  98.     my %sections;
  99.     my $o;
  100.     while (defined($o=pop(@{$this->{'options'}}))) {
  101.     my $sec = $o->{'order_section'};
  102.     push(@{$sections{($sec ? $sec : 'Queries')}}, $o);
  103.     }
  104.     $this->{'options'} = undef;
  105.  
  106.     # Put AnySetup stuff in DocumentSetup (or could be PageSetup)
  107.     push(@{$sections{'DocumentSetup'}}, @{$sections{'AnySetup'}});
  108.     @{$sections{'AnySetup'}} = ();
  109.  
  110.     # Now sort each section by orderdep number
  111.     my $k;
  112.     for $k (keys(%sections)) {
  113.     my @sorted = sort {$a->{'order_real'} 
  114.                <=> $b->{'order_real'}}   @{$sections{$k}};
  115.     $sections{$k} = \@sorted;
  116.     }
  117.  
  118.     $this->{'sections'} = \%sections;
  119. }
  120.  
  121.  
  122. sub pdq_options {
  123.     my $this = $_[0];
  124.  
  125.     my @opts;
  126.  
  127.     my $k;
  128.     for $k (@Sections) {
  129.     my $o;
  130.     for $o (@{$this->{'sections'}->{$k}}) {
  131.         my ($name, $label, $type, $default) = 
  132.         ($o->{'name'},$o->{'label'},$o->{'type'},$o->{'default'});
  133.  
  134.         if ($type eq 'PickOne' 
  135.         or $type eq 'Boolean'
  136.         or $type eq 'PickMany') {
  137.         push(@opts,
  138.              "  option {\n",
  139.              "    var = \"$name\"\n",
  140.              "    desc = \"$label\"\n",
  141.              "    default_choice \"$default\"\n");
  142.  
  143.         my $c;
  144.         for $c (@{$o->{'options'}}) {
  145.             my ($label, $option) = ($c->{'label'}, $c->{'option'});
  146.             push(@opts,
  147.              "    choice \"$name:$option\" {\n",
  148.              "      value = \"$option\"\n",
  149.              "      desc = \"$label\"\n",
  150.              "    }\n");
  151.         }
  152.  
  153.         push(@opts,
  154.              "  }\n");
  155.         }
  156.  
  157.         $optnum++;
  158.     }
  159.     }
  160.  
  161.     return @opts;
  162. }
  163.  
  164. sub _tag {
  165.     my ($t, @v) = @_;
  166.  
  167.     return '' if !defined(@v);
  168.  
  169.     if (0) {
  170.     $v =~ s!\&!\&\;!g;
  171.     $v =~ s!\<!\<\;!g;
  172.     }
  173.  
  174.     return "<$t>" . join('',@v) . "</$t>\n";
  175. }
  176.  
  177. sub foo_options {
  178.     my ($this) = (@_);
  179.  
  180.     # We build a list of option xml objects
  181.     my @options;
  182.  
  183.     # All of them need to get sandwiched between
  184.     # %!PS
  185.     # statusdict begin
  186.     #   opt1
  187.     #   opt2
  188.     #   ....
  189.     # end
  190.  
  191.     # For each section in the order defined by Adobe, and for each
  192.     # option in the order defined by the PPD, we emit shell code to
  193.     # generate the proper snippet-o-postscript into the backend
  194.     # filter's output.
  195.  
  196.     # TODO: some sections go in the middle of the document!  E-gad!
  197.     # TODO: JCL incantations - these aren't even parsed from the PPD yet.
  198.  
  199.     my $prn = $this->{'printer_id'};
  200.     my $filename = $this->{'filename'};
  201.     
  202.     my $k;
  203.     # AnySetup has already been moved to DocumentSetup.
  204.     # We don't do the JCL stuff yet.
  205.     for $k (qw(Prolog DocumentSetup PageSetup)) {
  206.     my $o;
  207.     my $optidx = 0;
  208.     for $o (@{$this->{'sections'}->{$k}}) {
  209.  
  210.         my (@opt) = ();
  211.  
  212.         # We only do PickOne and Boolean (no PickMany)
  213.         if ($o->{'type'} ne 'PickOne'
  214.         and $o->{'type'} ne 'Boolean') {
  215.         print STDERR ("Skipping option ", $o->{'name'}, 
  216.                   " because it is a ", $o->{'type'}, "\n");
  217.         next;
  218.         }
  219.  
  220.         # Skip "PageRegion", it is the same as "PageSize"
  221.         next if ($o->{'name'} eq "PageRegion");
  222.  
  223.         my ($var,$order) = @$o{'name','order_real'};
  224.  
  225.         # Find index of default option
  226.         my $c;
  227.         my $scanindex = 1;
  228.         my $defaultindex = 1; # assume first
  229.         for $c (@{$o->{'options'}}) {
  230.         my $v = $c->{'option'};
  231.         
  232.         if ($o->{'default'} eq $v) {
  233.             $defaultindex = $scanindex;
  234.             last;
  235.         }
  236.         
  237.         $scanindex++;
  238.         }
  239.  
  240.  
  241.         push (@opt, ("<option type='enum' id='ppd-$prn-$var'>\n",
  242.              "<!-- option from section $k in $filename -->\n",
  243.              _tag('arg_longname',
  244.                   _tag('en', xml_esc($o->{'label'}))),
  245.              _tag('arg_shortname',
  246.                   _tag('en', xml_esc($var))),
  247.              _tag('arg_execution',
  248.                   _tag('arg_order', 500 + $order),
  249.                   _tag('arg_spot', 'A'),
  250.                   "<arg_postscript section='$k' />\n",
  251.                   _tag('arg_proto', '%s')),
  252.              _tag('constraints',
  253.                   ("<constraint sense='true'>\n",
  254.                    _tag('driver', 'ppd'),
  255.                    _tag('printer', "printer/$prn"),
  256.                    _tag('arg_defval', "ppd-$prn-$var-$defaultindex"),
  257.                    "</constraint>\n"))));
  258.         
  259.         my $choiceidx=0;
  260.         my @evals;
  261.         for $c (@{$o->{'options'}}) {
  262.         my $v = $c->{'option'};
  263.         my $snippet = $c->{'snippet'};
  264.         $choiceidx++;
  265.         
  266.         if (defined($snippet)) {
  267.             
  268.             push (@evals,
  269.               ("<enum_val id='ppd-$prn-$var-$choiceidx'>\n",
  270.                _tag('ev_longname', 
  271.                 _tag('en', xml_esc($c->{'label'}))),
  272.                _tag('ev_shortname',
  273.                 _tag('en', xml_esc($c->{'option'}))),
  274.                ($snippet ? _tag('ev_driverval', xml_esc($snippet))
  275.                 : "<ev_driverval></ev_driverval>\n"),
  276.                "</enum_val>\n"));
  277.             
  278.             # TODO: We should also handle <##> hex numbers in snippets!
  279.         }
  280.         }
  281.  
  282.         # If there are choices, put them in
  283.         if (scalar(@evals)) {
  284.         push(@opt,
  285.              _tag('enum_vals', join('',@evals)));
  286.         
  287.         push (@opt, "</option>\n");
  288.  
  289.         # Note that we skip the whole thing if there are no choices!
  290.         push (@options, { 'id' => "ppd-$prn-$var",
  291.                   'xml' => \@opt } );
  292.         }
  293.     }
  294.     }
  295.     
  296.     return @options;
  297.  
  298. }    
  299.  
  300. sub xml_esc {
  301.     my ($in) = (@_);
  302.     
  303.     $in =~ s!&!&!g;
  304.     $in =~ s!<!<!g;
  305.     $in =~ s!>!>!g;
  306.  
  307.     return $in;
  308. }
  309.  
  310. sub pdq_filter {
  311.     my ($this) = $_[0];
  312.  
  313.     my @filt;
  314.  
  315.     push(@filt,
  316.      "  filter_exec {\n\n",
  317.      "    echo '%!PS' > \$OUTPUT\n",
  318.      "    echo 'statusdict begin' >> \$OUTPUT\n\n");
  319.  
  320.  
  321.     # For each section in the order defined by Adobe, and for each
  322.     # option in the order defined by the PPD, we emit shell code to
  323.     # generate the proper snippet-o-postscript into the PDQ filter's
  324.     # output.
  325.     #
  326.     # TODO: some sections go in the middle of the document!  E-gad!
  327.     # TODO: JCL incantations - these aren't even parsed from the PPD yet.
  328.  
  329.     my $k;
  330.     for $k (@Sections) {
  331.     my $o;
  332.     for $o (@{$this->{'sections'}->{$k}}) {
  333.         my ($var,$order) = @$o{'name','order_real'};
  334.         push (@filt,
  335.           "    # We put option $var in section $k order numer $order\n");
  336.         my $c;
  337.         my $first = 1;
  338.         for $c (@{$o->{'options'}}) {
  339.         my $el = ($first ? '' : 'el');
  340.         my $v = $c->{'option'};
  341.         my $snippet = $c->{'snippet'};
  342.  
  343.         if ($snippet) {
  344.             my @sniplines = split("\n", $snippet);
  345.             push(@filt, 
  346.              "    ${el}if [ \"\$$var\" = \"$v\" ]; then\n");
  347.             for (@sniplines) {
  348.             next if /^\s*$/;
  349.             $_ =~ s!\'!\\\'!g; # escape single quotes
  350.             # TODO: We should also handle <##> hex numbers!
  351.             push(@filt,
  352.                  "      echo \'$_\' >> \$OUTPUT;\n");
  353.             }
  354.  
  355.             $first = 0;
  356.         }
  357.         }
  358.         push (@filt, "    fi\n\n");
  359.     }
  360.     }
  361.  
  362.     push (@filt,
  363.       "    echo 'end' >> \$OUTPUT\n\n",
  364.       "    cat \$INPUT >> \$OUTPUT\n",
  365.       "  }\n");
  366.  
  367.     return @filt;
  368. }
  369.  
  370. sub pdq_driver {
  371.     my ($this) = @_;
  372.  
  373.     my $name = $this->get_name();
  374.     my $driver = $name;
  375.  
  376.     $driver =~ s!^\s*!!;
  377.     $driver =~ s!\s*$!!;
  378.     $driver =~ s!(\s+)!\-!g;
  379.     $driver = "$driver-0.1";
  380.  
  381.     my @drv;
  382.     push (@drv,
  383.       "driver $driver {\n\n",
  384.       "  help \"This driver was automagically converted from the \n",
  385.       "        PPD file for the $name by ppdtopdq.\"\n\n",
  386.       $this->pdq_options(),
  387.       "\n",
  388.       "  language_driver ps {\n",
  389.       "    filetype_regx = \"postscript\"\n",
  390.       "  }\n\n",
  391.       $this->pdq_filter(),
  392.       "}\n");
  393.  
  394.     return @drv;
  395. }
  396.  
  397. # get a nice pretty english name for this thing
  398. sub get_name {
  399.     my ($this) = @_;
  400.  
  401.     my ($mk,$md,$nk) = (@$this{'Manufacturer','ModelName','NickName'});
  402.  
  403.     my $name;
  404.     if ($mk) { $name = "$mk"; }
  405.     if ($md) { $name = "$name $md"; }
  406.     elsif ($nk) { $name = "$name $nk"; }
  407.  
  408.     return $name;
  409. }
  410.  
  411. 1;
  412.